home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / Programming / Source / winterp-1.13 / src-server / w_libXt.c < prev    next >
Encoding:
C/C++ Source or Header  |  1991-10-04  |  24.7 KB  |  772 lines
  1. /* -*-C-*-
  2. ********************************************************************************
  3. *
  4. * File:         w_libXt.c
  5. * RCS:          $Header: w_libXt.c,v 1.3 91/03/14 03:13:47 mayer Exp $
  6. * Description:  Random XLISP Primitives and Methods for the Xt Intrinsics
  7. * Author:       Niels Mayer, HPLabs
  8. * Created:      Fri Nov 24 00:36:13 1989
  9. * Modified:     Thu Oct  3 20:51:42 1991 (Niels Mayer) mayer@hplnpm
  10. * Language:     C
  11. * Package:      N/A
  12. * Status:       X11r5 contrib tape release
  13. *
  14. * WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  15. * XLISP version 2.1, Copyright (c) 1989, by David Betz.
  16. *
  17. * Permission to use, copy, modify, distribute, and sell this software and its
  18. * documentation for any purpose is hereby granted without fee, provided that
  19. * the above copyright notice appear in all copies and that both that
  20. * copyright notice and this permission notice appear in supporting
  21. * documentation, and that the name of Hewlett-Packard and David Betz not be
  22. * used in advertising or publicity pertaining to distribution of the software
  23. * without specific, written prior permission.  Hewlett-Packard and David Betz
  24. * make no representations about the suitability of this software for any
  25. * purpose. It is provided "as is" without express or implied warranty.
  26. *
  27. * HEWLETT-PACKARD AND DAVID BETZ DISCLAIM ALL WARRANTIES WITH REGARD TO THIS
  28. * SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS,
  29. * IN NO EVENT SHALL HEWLETT-PACKARD NOR DAVID BETZ BE LIABLE FOR ANY SPECIAL,
  30. * INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
  31. * LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE
  32. * OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
  33. * PERFORMANCE OF THIS SOFTWARE.
  34. *
  35. * See ./winterp/COPYRIGHT for information on contacting the authors.
  36. * 
  37. * Please send modifications, improvements and bugfixes to mayer@hplabs.hp.com
  38. * Post XLISP-specific questions/information to the newsgroup comp.lang.lisp.x
  39. **
  40. ********************************************************************************
  41. */
  42. static char rcs_identity[] = "@(#)$Header: w_libXt.c,v 1.3 91/03/14 03:13:47 mayer Exp $";
  43.  
  44. #include <stdio.h>
  45. #include <X11/Intrinsic.h>
  46. #include <X11/Shell.h>
  47. #include <Xm/Xm.h>        /* Xm/Xm.h only needed for "winterp.h"*/
  48. #include "winterp.h"
  49. #include "user_prefs.h"
  50. #include "xlisp/xlisp.h"
  51.  
  52. extern Widget Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(); /* w_classes.c */
  53.  
  54. /*****************************************************************************
  55.  * (send <widget> :SET_VALUES 
  56.  *                <resource_1> <value_1>
  57.  *                . . .
  58.  *                <resource_n> <value_n>)
  59.  * ==> returns <widget>
  60.  *
  61.  * void XtSetValues(widget, args, num_args);
  62.  *     Widget           widget;
  63.  *     ArgList          args;
  64.  *     Cardinal         num_args;
  65.  ****************************************************************************/
  66. LVAL Widget_Class_Method_SET_VALUES()
  67. {
  68.   extern ArgList Wres_Get_LispArglist(); /* from w_resources.c */
  69.   extern void    Wres_Free_C_Arglist_Data(); /* from w_resources.c */
  70.   LVAL    self;
  71.   Cardinal xt_numargs;
  72.   ArgList xt_arglist;
  73.   Widget  widget_id;
  74.  
  75.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  76.   
  77.   if (moreargs()) {
  78.     xt_arglist = Wres_Get_LispArglist(self, widget_id, NULL, 0, &xt_numargs);
  79.     XtSetValues(widget_id, xt_arglist, xt_numargs);
  80.     Wres_Free_C_Arglist_Data();
  81.   }
  82.   else
  83.     xlfail("In widget :set_values method, no arguments were given.");
  84.   
  85.   return (self);
  86. }
  87.  
  88.  
  89. /*****************************************************************************
  90.  * (send <widget> :GET_VALUES 
  91.  *                <resource_1> <place_1>
  92.  *                . . .
  93.  *                <resource_n> <place_n>)
  94.  * where <place_i> is a the place to put <resource_i>. If <place_i> is NIL,
  95.  * then <resource_i>'s value is returned in a list. If <place_i> is a quoted
  96.  * symbol, then that symbol gets <resource_i>'s value. If <place_i> is a 
  97.  * place-form (see 'setf') then <resource_i>'s value will be put in <place_i>:
  98.  *         <place>     the field specifier (quoted):
  99.  *                        <sym>                   set value of a symbol
  100.  *                        (car <expr>)            set car of a cons node
  101.  *                        (cdr <expr>)            set cdr of a cons node
  102.  *                        (nth <n> <expr>)        set nth car of a list
  103.  *                        (aref <expr> <n>)       set nth element of an array
  104.  *                        (get <sym> <prop>)      set value of a property
  105.  *                        (symbol-value <sym>)    set value of a symbol
  106.  *                        (symbol-function <sym>) set functional value of a symbol
  107.  *                        (symbol-plist <sym>)    set property list of a symbol
  108.  *
  109.  * void XtGetValues(widget, args, num_args);
  110.  *     Widget           widget;
  111.  *     ArgList          args;
  112.  *     Cardinal         num_args;
  113.  ****************************************************************************/
  114. LVAL Widget_Class_Method_GET_VALUES()
  115. {
  116.   extern ArgList Wres_Get_GetValues_ArgList();    /* from w_resources.c */
  117.   extern LVAL    Wres_GetValues_ArgList_To_Lisp(); /* from w_resources.c */
  118.   LVAL    self;
  119.   Cardinal xt_numargs;
  120.   ArgList xt_arglist;
  121.   Widget  widget_id;
  122.  
  123.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  124.  
  125.   if (moreargs()) {
  126.     xt_arglist = Wres_Get_GetValues_ArgList(&xt_numargs);
  127.     XtGetValues(widget_id, xt_arglist, xt_numargs);
  128.     return (Wres_GetValues_ArgList_To_Lisp(xt_arglist, xt_numargs)); /* sets the variables assoc'd w/ resource and/or return list of vars that weren't set */
  129.   }
  130.   else
  131.     xlfail("In widget :get_values method, no arguments were given.");
  132. }
  133.  
  134.  
  135. /*****************************************************************************
  136.  * (send <widget> :destroy) -- destroy a widget. 
  137.  * ==> returns NIL.
  138.  *
  139.  * After calling this routine, the WIDGETOBJ may be garbage collected, along
  140.  * with all other resources the widget references, such as PIXMAPs CALLBACKOBJs,
  141.  * and EVHANDLEROBJs. Furthermore, this will destroy all children of the
  142.  * destoyed widget and allow their storage to be garbage collected as well.
  143.  *
  144.  * void XtDestroyWidget (widget);
  145.  *     Widget widget;
  146.  ****************************************************************************/
  147. LVAL Widget_Class_Method_DESTROY()
  148. {
  149.   LVAL self;
  150.   Widget widget_id;
  151.  
  152.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  153.   xllastarg();
  154.  
  155.   XtDestroyWidget(widget_id);
  156.   return (NIL);
  157. }
  158.  
  159.  
  160. /*****************************************************************************
  161.  * (send <widget> :MANAGE)
  162.  * ==> returns <widget>
  163.  *
  164.  * This method will add <widget> to it's parent-widget's managed
  165.  * list, which means it will become visible (if mapped) and will take up space
  166.  * within the managing widget.
  167.  *
  168.  * void XtManageChild (child);
  169.  *      Widget    child;
  170.  ****************************************************************************/
  171. LVAL Widget_Class_Method_MANAGE()
  172. {
  173.   LVAL self;
  174.   Widget widget_id;
  175.  
  176.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  177.   xllastarg();
  178.  
  179.   XtManageChild(widget_id);
  180.   return (self);
  181. }
  182.  
  183.  
  184. /*****************************************************************************
  185.  * (send <widget> :UNMANAGE)
  186.  * ==> returns <widget>
  187.  *
  188.  * This method will remove <widget> from its parent's
  189.  * managed list, which means it will no longer be visible or take up space.
  190.  *
  191.  * void XtUnmanageChild (child);
  192.  *     Widget child;
  193.  ****************************************************************************/
  194. LVAL Widget_Class_Method_UNMANAGE()
  195. {
  196.   LVAL self;
  197.   Widget widget_id;
  198.  
  199.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  200.   xllastarg();
  201.  
  202.   XtUnmanageChild(widget_id);
  203.   return (self);
  204. }
  205.  
  206. /******************************************************************************/
  207. #define WIDGETLIST_SIZE_INCREMENT 20
  208. static Cardinal widgetlist_size = 0;
  209. static WidgetList widgetlist = NULL;
  210. WidgetList Get_Widget_List_or_Vector_Argument_Returning_WidgetList(num_children)
  211.      Cardinal *num_children;
  212. {
  213.   register Cardinal size, i;
  214.   LVAL elt, lval_widgets;
  215.   
  216.   lval_widgets = xlgetarg();
  217.  
  218.   if (vectorp(lval_widgets)) {
  219.     *num_children = size = (Cardinal) getsize(lval_widgets); /* get number of widgets */
  220.     if (size > widgetlist_size) { /* make sure it'll fit in current widgetlist array */
  221.       if (widgetlist)
  222.     widgetlist = (Widget*) XtRealloc(widgetlist, (unsigned) (size * sizeof(Widget)));
  223.       else
  224.     widgetlist = (Widget*) XtMalloc((unsigned) (size * sizeof(Widget)));
  225.       widgetlist_size = size;
  226.     }
  227.     for (i = 0 ; (i < size) ; i++) {
  228.       elt = getelement(lval_widgets, i);
  229.       if (widgetobj_p(elt)) {
  230.     if (!(widgetlist[i] = get_widgetobj_widgetID(elt)))
  231.       xlerror("widget object has been :destroy'd or hasn't been initialized by :isnew.", elt);
  232.       }
  233.       else
  234.     xlerror("Bad widget-vector element -- expected a vector of WIDGETOBJs.", elt);
  235.     }
  236.   }
  237.   else if (consp(lval_widgets)) {
  238.     for (i = 0 ; (consp(lval_widgets)) ; lval_widgets = cdr(lval_widgets), i++) {
  239.       if (i >= widgetlist_size)    { /* make sure it'll fit in current widgetlist array */
  240.     if (widgetlist)
  241.       widgetlist = (Widget*) XtRealloc(widgetlist, (unsigned) ((widgetlist_size + WIDGETLIST_SIZE_INCREMENT) * sizeof(Widget)));
  242.     else
  243.       widgetlist = (Widget*) XtMalloc((unsigned) (WIDGETLIST_SIZE_INCREMENT * sizeof(Widget)));
  244.     widgetlist_size += WIDGETLIST_SIZE_INCREMENT;
  245.       }
  246.       elt = car(lval_widgets);
  247.       if (widgetobj_p(elt)) {
  248.     if (!(widgetlist[i] = get_widgetobj_widgetID(elt)))
  249.       xlerror("widget object has been :destroy'd or hasn't been initialized by :isnew.", elt);
  250.       }
  251.       else
  252.     xlerror("Bad widget-list element -- expected a list of WIDGETOBJs.", elt);
  253.     }
  254.     if (lval_widgets)        /* if loop terminated due to list pointer not being a CONS cell */
  255.       xlerror("Bad widget-list element -- expected a list of WIDGETOBJs.", lval_widgets);
  256.     *num_children = i;
  257.   }
  258.   else
  259.     xlerror("Bad argument type -- expected a list or vector of WIDGETOBJs.", lval_widgets);
  260.  
  261.   return (widgetlist);        /* DO NOT FREE THIS RESULT */
  262. }
  263.  
  264. /******************************************************************************
  265.  * (XT_MANAGE_CHILDREN <widgets...>)
  266.  * ==> returns T.
  267.  * 
  268.  * Given a vector or list of widgets, all of which must be children of the
  269.  * same parent, this will add those widgets to their parent-widget's managed
  270.  * list, which means they will become visible (if mapped) and will take up space
  271.  * within the managing widget.
  272.  *
  273.  * An error will be signalled if the widgets passed to this routine  do not
  274.  * all have the same parent.
  275.  *
  276.  * void XtManageChildren(children, num_children)
  277.  *     WidgetList children;
  278.  *     Cardinal   num_children;
  279.  ******************************************************************************/
  280. LVAL Wxt_Prim_XT_MANAGE_CHILDREN()
  281. {
  282.   WidgetList children;
  283.   Cardinal num_children;
  284.   extern LVAL true;
  285.  
  286.   children = Get_Widget_List_or_Vector_Argument_Returning_WidgetList(&num_children);
  287.   xllastarg();
  288.  
  289.   XtManageChildren(children, num_children);
  290.  
  291.   return (true);
  292. }
  293.  
  294. /******************************************************************************
  295.  * (XT_UNMANAGE_CHILDREN <widgets...>)
  296.  * ==> returns T.
  297.  * 
  298.  * Given a vector or list of widgets, all of which must be children of the
  299.  * same parent, this will remove those child-widgets from their parent's
  300.  * managed list, which means they will no longer be visible or take up space.
  301.  *
  302.  * An error will be signalled if the widgets passed to this routine  do not
  303.  * all have the same parent.
  304.  *
  305.  * void XtUnmanageChildren (children, num_children)
  306.  *     WidgetList children;
  307.  *     Cardinal   num_children;
  308.  ******************************************************************************/
  309. LVAL Wxt_Prim_XT_UNMANAGE_CHILDREN()
  310. {
  311.   WidgetList children;
  312.   Cardinal num_children;
  313.   extern LVAL true;
  314.  
  315.   children = Get_Widget_List_or_Vector_Argument_Returning_WidgetList(&num_children);
  316.   xllastarg();
  317.  
  318.   XtUnmanageChildren(children, num_children);
  319.  
  320.   return (true);
  321. }
  322.  
  323.  
  324. /******************************************************************************
  325.  * (send <widget> :ADD_GRAB <exclusive_p> <spring_loaded_p>)
  326.  * ==>  returns <widget>
  327.  *
  328.  * Appends <widget> to the modal cascade -- redirects user input to this widget
  329.  * <exclusive_p> and <spring_loaded_p> are booleans.
  330.  *
  331.  * void XtAddGrab(widget, exclusive, spring_loaded)
  332.  *      Widget  widget;
  333.  *      Boolean exclusive;
  334.  *      Boolean spring_loaded;
  335.  ******************************************************************************/
  336. LVAL Widget_Class_Method_ADD_GRAB()
  337. {
  338.   LVAL self, exclusive_p, spring_loaded_p;
  339.   Widget widget_id;
  340.  
  341.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  342.   exclusive_p = xlgetarg();
  343.   spring_loaded_p = xlgetarg();
  344.   xllastarg();
  345.  
  346.   XtAddGrab(widget_id,
  347.         (exclusive_p) ? TRUE : FALSE,
  348.         (spring_loaded_p) ? TRUE : FALSE);
  349.   return (self);
  350. }
  351.  
  352.  
  353. /******************************************************************************
  354.  * (send <widget> :REMOVE_GRAB)
  355.  * ==>  returns <widget>
  356.  *
  357.  * Removes redirection of user input to <widget>.
  358.  * 
  359.  * void XtRemoveGrab(widget)
  360.  *     Widget  widget;
  361.  ******************************************************************************/
  362. LVAL Widget_Class_Method_REMOVE_GRAB()
  363. {
  364.   LVAL self;
  365.   Widget widget_id;
  366.  
  367.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  368.   xllastarg();
  369.  
  370.   XtRemoveGrab(widget_id);
  371.   return (self);
  372. }
  373.  
  374.  
  375. /******************************************************************************
  376.  * (send <widget> :IS_COMPOSITE)
  377.  * ==> returns T if <widget> is a composite widget,  else NIL.
  378.  *
  379.  * #define XtIsCompositeObject(widget) XtIsSubclass(widget, (WidgetClass) compositeObjectClass)
  380.  ******************************************************************************/
  381. LVAL Widget_Class_Method_IS_COMPOSITE()
  382. {
  383.   extern LVAL true;
  384.   LVAL self;
  385.   Widget widget_id;
  386.  
  387.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  388.   xllastarg();
  389.  
  390.  
  391. #ifndef WINTERP_MOTIF_11
  392.   return (XtIsCompositeObject(widget_id) ? true : NIL);
  393. #else
  394.   return (XtIsComposite(widget_id) ? true : NIL);
  395. #endif /* WINTERP_MOTIF_11 */
  396.  
  397.  
  398. }
  399.  
  400.  
  401. /******************************************************************************
  402.  * (send <widget> :IS_CONSTRAINT)
  403.  * ==> returns T if <widget> is a constraint widget, else NIL.
  404.  *
  405.  * #define XtIsConstraint(widget)      XtIsSubclass(widget, (WidgetClass) constraintWidgetClass)
  406.  ******************************************************************************/
  407. LVAL Widget_Class_Method_IS_CONSTRAINT()
  408. {
  409.   extern LVAL true;
  410.   LVAL self;
  411.   Widget widget_id;
  412.  
  413.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  414.   xllastarg();
  415.  
  416.   return (XtIsConstraint(widget_id) ? true : NIL);
  417. }
  418.  
  419.  
  420. /******************************************************************************
  421.  * (send <widget> :IS_SHELL)
  422.  * ==> returns T if <widget> is a shell widget, else NIL.
  423.  *
  424.  * #define XtIsShell(widget)        XtIsSubclass(widget, (WidgetClass) shellWidgetClass)
  425.  ******************************************************************************/
  426. LVAL Widget_Class_Method_IS_SHELL()
  427. {
  428.   extern LVAL true;
  429.   LVAL self;
  430.   Widget widget_id;
  431.  
  432.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  433.   xllastarg();
  434.  
  435.   return (XtIsShell(widget_id) ? true : NIL);
  436. }
  437.  
  438.  
  439. /******************************************************************************
  440.  * (send <widget> :SET_SENSITIVE <sensitive_p>)
  441.  * ==> returns <widget>.
  442.  *
  443.  * If <sensitive_p> is NIL, then the widget will not respond to user input.
  444.  *
  445.  * void XtSetSensitive (widget, sensitive)
  446.  *      Widget    widget;
  447.  *      Boolean   sensitive;
  448.  ******************************************************************************/
  449. LVAL Widget_Class_Method_SET_SENSITIVE()
  450. {
  451.   LVAL self, sensitive_p;
  452.   Widget widget_id;
  453.  
  454.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  455.   sensitive_p = xlgetarg();
  456.   xllastarg();
  457.  
  458.   XtSetSensitive(widget_id, 
  459.          (sensitive_p) ? TRUE : FALSE);
  460.   return (self);
  461. }
  462.  
  463.  
  464. /******************************************************************************
  465.  * (send <widget> :SET_MAPPED_WHEN_MANAGED <mapped_p>)
  466.  * ==> returns <widget>.
  467.  *
  468.  * If <mapped_p> is non-NIL, then the widget will be mapped (displayed).
  469.  *
  470.  * void XtSetMappedWhenManaged()
  471.  *      Widget    widget;
  472.  *      Boolean   mappedWhenManaged;
  473.  ******************************************************************************/
  474. LVAL Widget_Class_Method_SET_MAPPED_WHEN_MANAGED()
  475. {
  476.   LVAL self, mapped_p;
  477.   Widget widget_id;
  478.  
  479.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  480.   mapped_p = xlgetarg();
  481.   xllastarg();
  482.  
  483.   XtSetMappedWhenManaged(widget_id, 
  484.              (mapped_p) ? TRUE : FALSE);
  485.   return (self);
  486. }
  487.  
  488. /******************************************************************************
  489.  * (send <widget> :IS_MANAGED)
  490.  * ==> returns T if the widget is managed, else NIL. See method :MANAGE.
  491.  *
  492.  * Boolean XtIsManaged(widget)
  493.  *        Widget widget;
  494.  ******************************************************************************/
  495. LVAL Widget_Class_Method_IS_MANAGED()
  496. {
  497.   extern LVAL true;
  498.   LVAL self;
  499.   Widget widget_id;
  500.  
  501.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  502.   xllastarg();
  503.  
  504.   return (XtIsManaged(widget_id) ? true : NIL);
  505. }
  506.  
  507.  
  508. /******************************************************************************
  509.  * (send <widget> :IS_REALIZED)
  510.  * ==> returns T if the widget is realized, else NIL. See method :REALIZE.
  511.  *
  512.  * Boolean XtIsRealized (widget);
  513.  *         Widget widget;
  514.  ******************************************************************************/
  515. LVAL Widget_Class_Method_IS_REALIZED()
  516. {
  517.   extern LVAL true;
  518.   LVAL self;
  519.   Widget widget_id;
  520.  
  521.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  522.   xllastarg();
  523.  
  524.   return (XtIsRealized(widget_id) ? true : NIL);
  525. }
  526.  
  527.  
  528. /******************************************************************************
  529.  * (send <widget> :IS_SENSITIVE)
  530.  * ==> returns T if the widget will accept user input, else NIL. See also
  531.  * method :SET_SENSITIVE.
  532.  *
  533.  * Boolean XtIsSensitive(widget);
  534.  *         Widget widget;
  535.  ******************************************************************************/
  536. LVAL Widget_Class_Method_IS_SENSITIVE()
  537. {
  538.   extern LVAL true;
  539.   LVAL self;
  540.   Widget widget_id;
  541.  
  542.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  543.   xllastarg();
  544.  
  545.   return (XtIsSensitive(widget_id) ? true : NIL);
  546. }
  547.  
  548. /*****************************************************************************
  549.  * (send <widget> :PARENT)
  550.  * ==> returns the given <widget>'s parent widget or NIL if no parent.
  551.  *
  552.  * Widget XtParent(widget)
  553.  *        Widget widget;
  554.  *
  555.  * Note: for Motif 1.1 bug workaround for calling :PARENT on
  556.  * XmList/:scrolled and XmText/:scrolled widgets, see methods
  557.  * Xm_List_Widget_Class_Method_PARENT() and Xm_Text_Widget_Class_Method_PARENT()
  558.  ****************************************************************************/
  559. LVAL Widget_Class_Method_PARENT()
  560. {
  561.   extern LVAL Wcls_WidgetID_To_WIDGETOBJ();
  562.   LVAL self;
  563.   Widget widget_id;
  564.  
  565.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  566.   xllastarg();
  567.  
  568.   return (Wcls_WidgetID_To_WIDGETOBJ(XtParent(widget_id)));
  569. }
  570.  
  571.  
  572. /*****************************************************************************
  573.  * (send <widget> :WINDOW)
  574.  * ==> returns the given <widget>'s window.
  575.  *
  576.  * Window XtWindow(Widget);
  577.  * Window XtWindowOfObject(Widget);
  578.  ****************************************************************************/
  579. LVAL Widget_Class_Method_WINDOW()
  580. {
  581.   LVAL self;
  582.   Widget widget_id;
  583.   Window window_id;
  584.  
  585.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  586.   xllastarg();
  587.  
  588. #ifdef WINTERP_MOTIF_11
  589.   if (window_id = XtWindowOfObject(widget_id))
  590. #else
  591.   if (window_id = XtWindow(widget_id))
  592. #endif /* WINTERP_MOTIF_11 */
  593.     return (cv_window(window_id));
  594.   else
  595.     return (NIL);
  596. }
  597.  
  598.  
  599. /*****************************************************************************
  600.  * (send <widget> :MAP)
  601.  * ==> returns <widget>.
  602.  *
  603.  * If the widget is realized and managed, this method will make the window
  604.  * appear on the display. Make it disappear with :UNMAP.
  605.  *
  606.  * #define XtMapWidget(widget)    XMapWindow(XtDisplay(widget), XtWindow(widget))
  607.  ****************************************************************************/
  608. LVAL Widget_Class_Method_MAP()
  609. {
  610.   LVAL self;
  611.   Widget widget_id;
  612.  
  613.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  614.   xllastarg();
  615.  
  616.   if (
  617. #ifdef WINTERP_MOTIF_11
  618.       XtIsWidget(widget_id)
  619. #else
  620.       XtIsWindowObject(widget_id)
  621. #endif                /* WINTERP_MOTIF_11 */
  622.       ) {
  623.     XtMapWidget(widget_id);
  624.     return (self);
  625.   }
  626.   else 
  627.     xlerror("Method :MAP only applies to widgets, not gadgets.", self);
  628. }
  629.  
  630.  
  631. /*****************************************************************************
  632.  * (send <widget> :UNMAP)
  633.  * ==> returns <widget>.
  634.  *
  635.  * If the widget is realized and managed, this method will make the window
  636.  * disappear from the display. Make it reappear with :MAP.
  637.  *
  638.  * #define XtUnmapWidget(widget) XUnmapWindow(XtDisplay(widget), XtWindow(widget))
  639.  ****************************************************************************/
  640. LVAL Widget_Class_Method_UNMAP()
  641. {
  642.   LVAL self;
  643.   Widget widget_id;
  644.  
  645.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  646.   xllastarg();
  647.  
  648.   if (
  649. #ifdef WINTERP_MOTIF_11
  650.       XtIsWidget(widget_id)
  651. #else
  652.       XtIsWindowObject(widget_id)
  653. #endif                /* WINTERP_MOTIF_11 */
  654.       ) {
  655.     XtUnmapWidget(widget_id);
  656.     return (self);
  657.   }
  658.   else 
  659.     xlerror("Method :UNMAP only applies to widgets, not gadgets.", self);
  660. }
  661.  
  662.  
  663. #ifdef WINTERP_MOTIF_11        /* actually, just X11r4, but Motif1.1-->X11r4 */
  664. /*****************************************************************************
  665.  * (send <widget> :NAME)
  666.  * ==> returns string of widget's name.
  667.  *
  668.  * extern String XtName(Widget object);
  669.  ****************************************************************************/
  670. LVAL Widget_Class_Method_NAME()
  671. {
  672.   LVAL self;
  673.   Widget widget_id;
  674.  
  675.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  676.   xllastarg();
  677.  
  678.   return (cvstring((char*) XtName(widget_id)));    /* XtName String return is copied by cvstring(), copy is freed by XLISP-GC */
  679. }
  680. #endif /* WINTERP_MOTIF_11 */
  681.  
  682.  
  683. #ifdef WINTERP_MOTIF_11
  684. /******************************************************************************
  685.  * (XT_RESOLVE_PATHNAME <type> <filename> <suffix> <path>)
  686.  *    ==> returns a string representing the pathname of an existing file
  687.  *        created from the parameters  <type> <filename> <suffix> <path>.
  688.  *        will return NIL if no such file exists, is readable, and
  689.  *        isn't a directory.
  690.  *
  691.  * where
  692.  *
  693.  * <path> is a string of paths separated by colons (':'), in which the 
  694.  *     following substituions are done:
  695.  *    %N -- gets substituted by the parameter <filename>, a name without the extension.
  696.  *    %T -- gets substituted by the parameter <type>, a directory name. 
  697.  *    %S -- gets substituted by the parameter <suffix>.
  698.  *    
  699.  *    X11r4 Language-dependent substitutions for %L, %l %t, %c may occur as well.
  700.  *    See the documentation for XtResolvePathname() for further details.
  701.  *
  702.  * <type> is a STRING, or NIL. This substitutes for occurrences of %T in <path>.
  703.  *
  704.  * <filename> is a STRING. If this parameter is NIL, then note that XtResolvePathname()
  705.  *    will substitute the application class name.
  706.  *
  707.  * <suffix> is a STRING, or NIL. This substitutes for occurrences of %S in <path>.
  708.  * 
  709.  * String XtResolvePathname(
  710.  *     Display*    dpy,
  711.  *     CONST String type,
  712.  *     CONST String filename,
  713.  *     CONST String suffix,
  714.  *     CONST String path,
  715.  *     Substitution substitution,
  716.  *     Cardinal num_substitutions,
  717.  *     XtFilePredicate predicate)
  718.  ******************************************************************************/
  719. LVAL Wxt_Prim_XT_RESOLVE_PATHNAME()
  720. {
  721.   extern Display* display;    /* global in winterp.c */
  722.   String type, filename, suffix, path;
  723.   String result;
  724.   /*  LVAL lval_result; */
  725.  
  726.   if (moreargs() && (*xlargv == NIL)) {    /* get <type> */
  727.     type = NULL;
  728.     nextarg();
  729.   }
  730.   else
  731.     type = (String) getstring(xlgastring());
  732.  
  733.   if (moreargs() && (*xlargv == NIL)) {    /* get <filename> */
  734.     filename = NULL;
  735.     nextarg();
  736.   }
  737.   else
  738.     filename = (String) getstring(xlgastring());
  739.  
  740.   if (moreargs() && (*xlargv == NIL)) {    /* get <suffix> */
  741.     suffix = NULL;
  742.     nextarg();
  743.   }
  744.   else
  745.     suffix = (String) getstring(xlgastring());
  746.  
  747.   if (moreargs() && (*xlargv == NIL)) {    /* get <path> */
  748.     path = NULL;
  749.     nextarg();
  750.   }
  751.   else
  752.     path = (String) getstring(xlgastring());
  753.  
  754.   xllastarg();
  755.  
  756.   result = XtResolvePathname(display, type, filename, suffix, path,
  757.                  (Substitution) NULL, 0,
  758.                  (XtFilePredicate) NULL);
  759.  
  760.   if (result) {
  761. /*
  762.     lval_result = cvstring(result);
  763.     XtFree(result);
  764.     return (lval_result);
  765. */
  766.     return (cv_string(result));    /* XtResolvePathname() result is not copied, will be freed by XLISP-GC */
  767.   }
  768.   else
  769.     return (NIL);
  770. }
  771. #endif
  772.